home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
t3_1
/
risc_src.lha
/
risc_sources
/
sys
/
frame.t
< prev
next >
Wrap
Text File
|
1989-06-30
|
4KB
|
100 lines
(herald frame (env tsys))
;;; Copyright (c) 1985 Yale University
;;; Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
;;; This material was developed by the T Project at the Yale University Computer
;;; Science Department. Permission to copy this software, to redistribute it,
;;; and to use it for any purpose is granted, subject to the following restric-
;;; tions and understandings.
;;; 1. Any copy made of this software must include this copyright notice in full.
;;; 2. Users of this software agree to make their best efforts (a) to return
;;; to the T Project at Yale any improvements or extensions that they make,
;;; so that these may be included in future releases; and (b) to inform
;;; the T Project of noteworthy uses of this software.
;;; 3. All materials developed as a consequence of the use of this software
;;; shall duly acknowledge such use, in accordance with the usual standards
;;; of acknowledging credit in academic research.
;;; 4. Yale has made no warrantee or representation that the operation of
;;; this software will be error-free, and Yale is under no obligation to
;;; provide any services, by way of maintenance, update, or otherwise.
;;; 5. In conjunction with products arising from the use of this material,
;;; there shall be no use of the name of the Yale University nor of any
;;; adaptation thereof in any advertising, promotional, or sales literature
;;; without prior written consent from Yale in each case.
;;;
;;;; stuff for hacking stack frames
;;; Frame-previous returns frame in stack to which the given stack
;;; frame will return. If there is no such "superior", return null.
(define (closure? obj)
(and (extend? obj)
(template? (extend-header obj))))
(define (frame? obj)
(and (extend? obj)
(template? (frame-header obj))))
(define handle-stack-base
(object nil
((frame-previous frame) (ignore frame) nil)
((get-environment frame) (ignore frame) nil)
((frame-print-synopsis frame port) (ignore frame port) nil)
((print-type-string self) "Stack-base")))
(define handle-magic-frame
(object nil
((get-environment frame) (ignore frame) nil)
((frame-print-synopsis frame port) (ignore frame port) nil)
((print-type-string self) "Dynamic-state-transition")))
(define (frame-any pred frame)
(cond ((frame? frame)
(let ((limit (frame-size frame)))
(iterate loop2 ((i 0))
(cond ((fx>= i limit) nil)
((pred (extend-pointer-elt frame i)))
(else (loop2 (fx+ i 1)))))))
(else nil)))
(define (frame-size thing)
(cond ((frame? thing)
(template-pointer-slots (frame-header thing)))
(else 0)))
(define-operation (frame-previous frame)
(let ((frame (enforce frame? frame)))
(let ((tem (frame-header frame)))
(make-pointer frame (template-pointer-slots tem)))))
(define (closure-size-info closure)
(let ((tem (extend-header closure)))
(return (template-pointer-slots tem) 0)))
(define (template-definer tem)
(let ((offset (template-definer-vcell-offset tem)))
(if offset
(vcell-id (extend-pointer-elt (template-unit tem) offset))
nil)))
(define (template-unit tem)
(let ((thing (template-enclosing-object tem)))
(xcond ((not (bytev? thing)) thing)
((weak-table-entry code-unit-table thing)))))
(define (template-definer-vcell-offset template)
(let ((template (if (fixnum-equal? (template-nargs template) 0)
(extend-elt template 0)
template)))
(let ((offset (fixnum-ashr (mref-16-u template
(fx+ -2 template/annotation)) 3)))
(if (fx= offset 0)
nil
(fx- offset 1)))))